COMMENT ⊗   VALID 00007 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002		 Here is the LISP source code required to answer HomeWork Set 6
C00006 00003	  Solution to Question #2 [Replacing]
C00011 00004	  Solution to Question #3 [Macro]
C00013 00005	  Solution to Question #4 [Iteration]
C00014 00006	  Solution to Question #5 [FEXPR,LEXPR]
C00016 00007	  Solution to Question #6 [DISCUSSION]
C00020 ENDMK
C⊗;
	; Here is the LISP source code required to answer HomeWork Set 6
	; Spring 1979

 ; Solution to Question #1 [Diagnosing]
; Part 1
(DEFUN %MUST-BE (PHI VAL)
	(TIMES VAL PHI))

(DEFUN %MUST-NOT-BE (PHI VAL)
	(DIFFERENCE 1.0 (TIMES VAL (DIFFERENCE 1.0 PHI))))

(DEFUN %SHOULD-BE (PHI VAL)
	(AVE VAL PHI))

(DEFUN %SHOULD-NOT-BE (PHI VAL)
	(DIFFERENCE 1.0 (AVE VAL (DIFFERENCE 1.0 PHI))))

(DEFUN %MAY-BE (PHI VAL)
	(MAX VAL PHI))

(DEFUN %MAY-NOT-BE (PHI VAL)
	(DIFFERENCE 1.0 (MAX VAL (DIFFERENCE 1.0 PHI))))

; Part 2
(DEFUN PROBABLY-HAS (PAT DIS) 					      
 ; This returns the likelihood the patient PAT has the disease DIS
       ((LAMBDA (VALUE) 
		(MAPC '(LAMBDA (A-SYMP) 
			       (SETQ VALUE (TEST-1 PAT A-SYMP VALUE)))
		      (GET DIS 'SYMPTOM))
		VALUE)						      
 ; so this gets returned
	(GET DIS 'A-PRIORI))) 

(DEFUN TEST-1 (PAT SYMP VAL) 					      
 ; Updates the likelihood value, VAL
 ;  based on "probability" the patient PAT has sympton, SYMP
	(FUNCALL (CDR SYMP) VAL (FUNCALL (CAR SYMP) PAT)))

; Part 3
(DEFUN UPDATE (THE-DISEASES)
	; Reads thru list of disease-names, updating each:
	((LAMBDA (HASHES)
	  ((LAMBDA (MAXL)
	     (MAPC 'PROCESS-1 THE-DISEASES HASHES)
	     '|Update completed| )
	   (FLOAT (APPLY 'MAX HASHES))))  ; so MAXL is maximal hashing value
	 (MAPCAR 'SXHASH THE-DISEASES)))

(DEFUN PROCESS-1 (A-DIS MY-HASH)
	; This updates a single disease, whose name hashes to MY-HASH
	; Uses GLOBAL value, MAXL [FLONUM, so Quotient is FLONUM]
	(PUTPROP A-DIS (DIFFERENCE 1.0 (QUOTIENT MY-HASH MAXL))
		       'A-PRIORI)
		; Below run only for its side effect, via the RPLACD.
	(MAPC '(LAMBDA (SYMP-PAIR)
		(RPLACD SYMP-PAIR (IMPLODE (CONS '% (EXPLODE (CDR SYMP-PAIR))))))
	      (GET A-DIS 'SYMPTOM)))
 ; Solution to Question #2 [Replacing]
   ; These use the MTCH? function (and its friends) written last assignment

; Part 1
(DEFUN REPLACE-AUX (SEXP PAT NEW) 
	  ; I assume $FOUND-IT is set to NIL initially, Otherwise, no substitution
       (COND ((MTCH? PAT SEXP) (SETQ $FOUND-IT T) NEW)  ; so NEW returned
	     ((ATOM SEXP) SEXP)
	     (T (CONS (REPLACE-AUX (CAR SEXP) PAT NEW) 
		      (COND ($FOUND-IT (CDR SEXP))
			    (T		(REPLACE-AUX (CDR SEXP) PAT NEW)))))))

; a)
(DEFUN REPLACE (SEXP PAT NEW) 
	(SETQ $FOUND-IT NIL)
	(REPLACE-AUX SEXP PAT NEW) )

; b)
(DEFUN REPLACE FEXPR (*X) 
		; We could do some error checking here...
	(SETQ $FOUND-IT NIL)
	(REPLACE-AUX (CAR *X) (CADR *X) (CADDR *X)) )

 ; Part 2
(DEFUN NREPLACE-AUX (SEXP PAT NEW) 
       (COND ((MTCH? PAT SEXP) '|.here.|)
	     ((ATOM SEXP) NIL)
	     (((LAMBDA (IS-CAR) (AND (EQ IS-CAR '|.here.|)
				     (RPLACA SEXP NEW)
				     T))
	       (NREPLACE-AUX (CAR SEXP) PAT NEW)))
	     (((LAMBDA (IS-CDR) (AND (EQ IS-CDR '|.here.|)
				     (RPLACD SEXP NEW)
				     T))
	       (NREPLACE-AUX (CDR SEXP) PAT NEW))))) 

 ; Question: Why would it make little sense for nREPLACE to be a FEXPR?
(DEFUN NREPLACE (OLD PAT NEW) 
       ((LAMBDA (RETURN-VAL)  ; RETURN-VAL ε {T |.here.| NIL}
	 (COND ((EQ RETURN-VAL '|.here.|)
		(ERROR-1 (LIST '|I cannot do the substitution: |
			       OLD))
		(SETQ $FOUND-IT NIL))
	       (RETURN-VAL (SETQ $FOUND-IT T))
	       (T (SETQ $FOUND-IT NIL)))
	 OLD)
	(NREPLACE-AUX OLD PAT NEW))) 

 ; Part 3
(DEFUN REPLACE-1AUX (SEXP PAT NEW n)
       (COND ((= $FOUND-NUM n) SEXP)
             ((MTCH? PAT SEXP) (SETQ $FOUND-NUM (1+ $FOUND-NUM)) NEW)
	     ((ATOM SEXP) SEXP)
	     (T (CONS (REPLACE-1AUX (CAR SEXP) PAT NEW n)
		      (REPLACE-1AUX (CDR SEXP) PAT NEW n))))) 

(DEFUN REPLACE-1 (OLD PAT NEW n)
	(SETQ $FOUND-NUM 0.)		; This will be incemented.
	(REPLACE-1AUX OLD PAT NEW (COND ((EQ n 'INFINITY) -1)
					(T n))))

	(REPLACE-1 '(A (A (A (A (A (A B)))))) '(A B) 'B 'INFINITY)
(A (A (A (A (A B)))))
   ; Note it does NOT use the new replaced value when scanning for the pattern

 ; Part 4
(DEFUN nREPLACE-1AUX (SEXP PAT NEW n)
       (COND ((= $FOUND-NUM n) NIL)
             ((MTCH? PAT SEXP) (SETQ $FOUND-NUM (1+ $FOUND-NUM))
				'|.here.|)
	     ((ATOM SEXP) NIL)
	     (T ((LAMBDA (IS-CAR IS-CDR)
		   (AND	(EQ IS-CAR '|.here.|)
			(RPLACA SEXP NEW))
		   (AND	(EQ IS-CDR '|.here.|)
			(RPLACD SEXP NEW))
		   NIL)
		 (NREPLACE-1AUX (CAR SEXP) PAT NEW n)
		 (NREPLACE-1AUX (CDR SEXP) PAT NEW n))))) 

(DEFUN nREPLACE-1 (OLD PAT NEW n)
	(SETQ $FOUND-NUM 0.)
	((LAMBDA (RETURN-VAL) 					      
	  ; RETURN-VAL ε {|.here.| NIL}
	  (COND ((EQ RETURN-VAL '|.here.|)
		 (ERROR-1 (LIST '|I cannot do the substitution: |
				OLD))
		 (SETQ $FOUND-NUM 0.))
		(T NIL))
	 OLD)
	(nREPLACE-1AUX OLD PAT NEW (COND ((EQ n 'INFINITY) -1)
					 (T n)))))

  ; Calling nREPLACE n times would then use the new value when searching for the
  ; the pattern. This scheme does not.
  ;      NOTE:        (nREPLACE '(B) 'B '(B B) 'INFINITY) 
  ; would take a long time under that system
 ; Solution to Question #3 [Macro]
	; I use the MTCH? and CODE functions written last assignment
(DEFUN IF MACRO (X) (CATCH (CONS 'COND (IF-1 (CDR X))) BAD-IF)) 

(DEFUN IF-1 (X) 
       (PROG (?BOOL *THEN-PART *T-P *E-P) 
		; (↑) these variables SET within some MTCH?
		; NOTE: Despite what HW says, IF 4 5 nil THEN ... 
		; really does not make sense, and so was not coded.
	     (COND ((MTCH? '(?BOOL THEN *THEN-PART) X)
		    (RETURN (COND ((MTCH? '(*T-P ELSEIF *E-P)
					  *THEN-PART)
				   (CONS (CONS ?BOOL *T-P)
					 (IF-1 *E-P)))
				  ((MTCH? '(*T-P ELSE *E-P)
					  *THEN-PART)
				   (CODE '((?BOOL *T-P) (T *E-P))))
				  (T (CODE '((?BOOL *THEN-PART)
					     (T NIL)))))))
		   (T (ERROR-1 (LIST '|Improperly formed IF clause|
				     X))
		      (THROW NIL BAD-IF))))) 
 ; Solution to Question #4 [Iteration]

(DEFUN FIB (N) 
       (DO ((I 1. (1+ I))
	    (FIB-I 1. (+ FIB-I FIB-I-1))
	    (FIB-I-1 0. FIB-I))
	   ((= I N) FIB-I))) 
 ; Solution to Question #5 [FEXPR,LEXPR]

(DEFUN OR-F FEXPR (OR-F-VARIABLE) 
       (COND ((NULL OR-F-VARIABLE) NIL)
	     ((EVAL (CAR OR-F-VARIABLE)))
	     ((APPLY 'OR-F (CDR OR-F-VARIABLE))))) 

(DEFUN OR-L NUM-ARGS 
       (DO ((I 1. (1+ I)))
	   ((> I NUM-ARGS) NIL)
	   ((LAMBDA (ARG-I)
		(AND ARG-I (RETURN ARG-I)))
	    (ARG I)))) 

; OR cannot be an EXPR, as it can take an arbitrary number of arguments.

; Each of the above forms is inaccurate for some cases:
;   OR-F will NOT work properly when its argument name (here OR-F-VARIABLE)
;	is shadowing some other relevant variable:
;	EG (SETQ OR-F-VARIABLE T)
;	   (OR-F OR-F-VARIABLE)
;	 will return
;	   (OR-F-VARIABLE), not T.
;   OR-L will NOT work properly any of its values produces some side effect:
;	So  (OR-L T (PRINT 'BLAH))  will print BLAH, then return T
 ; Solution to Question #6 [DISCUSSION]
EXPRs are useful when you, the programmer, know just how many arguments some
function will require, when all of these should be evaluated in the
environment of its calling site.
It is inapplicable when this function may take an arbitrary number of arguments,
or when these arguments should not be (immediately) evaluated.

A LEXPR is essential when the function may take some unspecified number of
arguments, and when these arguments must be evaluated at the calling site.
[The reasons for this will be clearer when compiling is discussed.]

FEXPRs basically save the user from typing a slew of '' ' ''s, as it does not
evaluate its sole argument. It may effectively be passed an arbitrary number of
values, which it accepts as a list.

The real win of MACROs comes when compiling. In this case,
the macro will be expanded into the relevant code but once,
at compile-time.
Notice the resultant generated code will NOT have a function call there;
it will be as if the output of the MACRO's evalution had been spliced in
its place.
To compare a MACRO will a comparable function (eg FEXPR,) notice:
A whole body of code will be generated for each occurrence of the macro,
whereas this body would have been stored but once had a function been defined.
However, at each site, the MACRO will require
less time to execute than that equivalent function call,
as the MACRO requires no function call - the code has already been spliced in.

There are some advantages of using a macro over the corresponding code directly:
First, each MACRO may have a mneumonic name, which indicates its function.
This is immennsely useful for debugging.
Second, each MACRO, (like any function,) may be regarded as storing a morsel
of  information, hidden from the "calling" program.
For example, one could adopt a totally new data structure 
by just modifying the relavent macros;
leaving the overall program identical.